#
# coloured petri net implementation, transitions
# alpha version, API and features might change
#
# Copyright (c) 2002 Torvald Riegel. All rights reserved. This program is
# free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
#

package PetriNet::Coloured::Transition;

use strict;
use Carp;

sub new {
    my ($type) = @_;
    return bless {
                  arcsIn => {},
                  arcsOut => {},
                  guard => undef,
                  code => undef,
                  net => undef,
                  noSteps => 1,
                 }, $type;
}

sub setNet {
    my ($self) = shift;
    $self->{net} = shift;
}

#
# input arc accessors
#
sub setArcIn {
    my ($self, $place, $arc) = @_;
    if (not defined $arc) {
        delete $self->{arcsIn}->{$place};
    } else {
        # TODO is_a check for arc
        $self->{arcsIn}->{$place} = $arc;
    }
    # rebuilds arcvector
    $self->buildArcVector();
}

sub getArcIn {
    my ($self, $place) = @_;
    croak "no arc from this place" unless $self->existsArcIn($place);
    return $self->{arcsIn}->{$place};
}

sub getInputPlaces {
    my $self = shift;
    return keys %{$self->{arcsIn}};
}

sub existsArcIn {
    my ($self, $place) = @_;
    return exists $self->{arcsIn}->{$place};
}

#
# output arc accessors
#
sub setArcOut {
    my ($self, $place, $expr) = @_;
    if (not defined $expr) {
        delete $self->{arcsOut}->{$place};
    } else {
        $self->{arcsOut}->{$place} = $expr;
    }
}

#
# guard/code setter
#
sub setGuard {
    my $self = shift;
    $self->{guard} = shift;
}

sub setCode {
    my $self = shift;
    $self->{code} = shift;
}


#
# executeStep helper
#
sub buildArcVector {
    my $self = shift;
    $self->{arcvector} = [keys %{$self->{arcsIn}}];
    # TODO: sort the arcs, smallest step/tokencount first (aim: minimize
    # the impossible steps that are tried
    # resets combination start
    $self->setCombinationFirst();
}

sub setCombinationFirst {
    my ($self, $pos) = @_;
    $pos = -1 unless defined $pos;
    $self->{combinationfirst} = $pos;
}


# returns true if a step was executed
sub executeStep {
    my ($self) = @_;

    return if $self->{noSteps};

    # rebuilds arc vector if needed
    unless (@{$self->{arcvector}}) {
        $self->buildArcVector();
    }

    # searches through the remaining combinations
    $self->setCombinationFirst() unless defined $self->{combinationfirst};
    my $combipos = 0;
    my @combi = ($self->{combinationfirst});
    my @combistep = ();
    while (1) {

        # next step combination, stop if the first step is reached
        $combi[$combipos]++;
        last if $combipos == 0
          and $combi[$combipos] == $self->{combinationfirst};

        # asks for the step and a new (updated) index
        (my $newindex, $combistep[$combipos]) = $self->{arcsIn}
          ->{$self->{arcvector}->[$combipos]}
          ->getStep($combi[$combipos],
                    $self->{net}
                    ->getPlace($self->{arcvector}->[$combipos]),
                    'default');

        # arc step handling, checks the new index first
        if ($newindex == -1) {
            # -1 means out of range (steps of the current arc)
            # detects no steps for an arc
            if ($combi[$combipos] == 0) {
                $self->{noSteps} = 1;
                return 0;
            }
            # wrap, either full wrap or back to the former arc
            if ($combipos == 0) {
                # first pos, reset combo
                $combi[0] = -1;
            } else {
                # return to the former arc
                $combipos--;
            }
        }
        # processes the step if it is still available
        elsif (defined $combistep[$combipos]) {
            # find a full combination
            die "BUG shrinking at first pos, what is combinationfirst now?"
              unless $combipos or $newindex == $combi[$combipos];
            $combi[$combipos] = $newindex;

            if ($combipos < $#{$self->{arcvector}}) {
                $combipos++;
                $combi[$combipos] = -1;
            }

            else {
                # merge BE from the arc steps
                foreach (0..$#combistep) {
                    my $h = $combistep[$_]->[0];
                    if (exists $h->{default}) {
                        $h->{$self->{arcvector}->[$_]} = $h->{default};
                        delete $h->{default};
                    }
                    #push %be, %$h;
                }
                my %be = map(%{$_->[0]}, @combistep);
                # applies the guard expr
                if ( ! defined($self->{guard}) or & {$self->{guard}} (\%be)) {
                    # TODO: flag: run / return step (for debug mode)
                    # token removing
                    foreach (0..$#combistep) {
                        $self->{net}->getPlace($self->{arcvector}->[$_])
                          ->removeToken(@{$combistep[$_]->[1]});
                    }
                    # removes the arc and transition steps
                    # TODO: increase performance
                    # (atm steps removed after token notify)
                    # executes the transition code
                    & {$self->{code}} (\%be) if defined $self->{code};
                    # produces new tokens
                    foreach (keys %{$self->{arcsOut}}) {
                        $self->{net}->getPlace($_)->addToken
                          (& {$self->{arcsOut}->{$_}} (\%be));
                    }
                    # set combo to the current step, it will get increased
                    # in the beginning of this loop before new steps are
                    # tested
                    $self->{combinationfirst} = $combi[0];
                    # return that one step was executed
                    return 1;
                }
            }
        }
    }
    # destroys arc vector if it could increase performance
    # TODO
    # goes into noSteps state
    $self->{noSteps} = 1;
    return 0;
}



# notifies the transition about a new token on a place
# params: place, token ids
sub tokenAdded {
    my ($self, $place, @tokens) = @_;

    # ignores the notifications unless there is an input arc from the place
    # should not happen (net->placeTransitionRel)
    #return unless exists $self->{arc_in}->{$place};
    # notifies the arc
    $self->{arcsIn}->{$place}->tokenAdded(@tokens);
    # move the arc with the new token to the end of the arc vector if in
    # noSteps state
    if ($self->{noSteps}) {
        # TODO sorting again should be better
    }
    # goes out of noSteps state
    # TODO more checks (steps for all arcs etc...)
    $self->{noSteps} = 0;
}


# notifies the transition about removed tokens
# params: place, token ids
sub tokenRemoved {
    my ($self, $place, @tokens) = @_;

    # ignores the notifications unless there is an input arc from the place
    # shouldnt happen: return unless exists $self->{arcsIn}->{$place};
    # notifies the arc
    $self->{arcsIn}->{$place}->tokenRemoved(@tokens);
}







1;
